home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / realse1a / wsksock.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-17  |  37.3 KB  |  862 lines
  1. Attribute VB_Name = "WSKSOCK"
  2. 'date stamp: sept 1, 1996 (for version control, please don't remove)
  3.  
  4. 'Visual Basic 4.0 Winsock "Header"
  5. '   Alot of the information contained inside this file was originally
  6. '   obtained from ALT.WINSOCK.PROGRAMMING and most of it has since been
  7. '   modified in some way.
  8. '
  9. 'Disclaimer: This file is public domain, updated periodically by
  10. '   Topaz, SigSegV@mail.utexas.edu, Use it at your own risk.
  11. '   Neither myself(Topaz) or anyone related to alt.programming.winsock
  12. '   may be held liable for its use, or misuse.
  13. '
  14. 'Declare check Aug 27, 1996. (Topaz, SigSegV@mail.utexas.edu)
  15. '   All 16 bit declarations appear correct, even the odd ones that
  16. '   pass longs inplace of in_addr and char buffers. 32 bit functions
  17. '   also appear correct. Some are declared to return integers instead of
  18. '   longs (breaking MS's rules.) however after testing these functions I
  19. '   have come to the conclusion that they do not work properly when declared
  20. '   following MS's rules.
  21. '
  22. 'NOTES:
  23. '   (1) I have never used WS_SELECT (select), therefore I must warn that I do
  24. '       not know if fd_set and timeval are properly defined.
  25. '   (2) Alot of the functions are declared with "buf as any", when calling these
  26. '       functions you may either pass strings, byte arrays or UDT's. For 32bit I
  27. '       I recommend Byte arrays and the use of memcopy to copy the data back out
  28. '   (3) The async functions (wsaAsync*) require the use of a message hook or
  29. '       message window control to capture messages sent by the winsock stack. This
  30. '       is not to be confused with a CallBack control, The only function that uses
  31. '       callbacks is WSASetBlockingHook()
  32. '   (4) Alot of "helper" functions are provided in the file for various things
  33. '       before attempting to figure out how to call a function, look and see if
  34. '       there is already a helper function for it.
  35. '   (5) Data types (hostent etc) have kept there 16bit definitions, even under 32bit
  36. '       windows due to the problem of them not working when redfined following the
  37. '       suggested rules.
  38. Option Explicit
  39.  
  40. Public Const FD_SETSIZE = 64
  41. Type fd_set
  42.     fd_count As Integer
  43.     fd_array(FD_SETSIZE) As Integer
  44. End Type
  45.  
  46. Type timeval
  47.     tv_sec As Long
  48.     tv_usec As Long
  49. End Type
  50.  
  51. Type HostEnt
  52.     h_name As Long
  53.     h_aliases As Long
  54.     h_addrtype As Integer
  55.     h_length As Integer
  56.     h_addr_list As Long
  57. End Type
  58. Public Const hostent_size = 16
  59.  
  60. Type servent
  61.     s_name As Long
  62.     s_aliases As Long
  63.     s_port As Integer
  64.     s_proto As Long
  65. End Type
  66. Public Const servent_size = 14
  67.  
  68. Type protoent
  69.     p_name As Long
  70.     p_aliases As Long
  71.     p_proto As Integer
  72. End Type
  73. Public Const protoent_size = 10
  74.  
  75. Public Const IPPROTO_TCP = 6
  76. Public Const IPPROTO_UDP = 17
  77.  
  78. Public Const INADDR_NONE = &HFFFFFFFF
  79. Public Const INADDR_ANY = &H0
  80.  
  81. Type sockaddr
  82.     sin_family As Integer
  83.     sin_port As Integer
  84.     sin_addr As Long
  85.     sin_zero As String * 8
  86. End Type
  87. Public Const sockaddr_size = 16
  88. Public saZero As sockaddr
  89.  
  90.  
  91. Public Const WSA_DESCRIPTIONLEN = 256
  92. Public Const WSA_DescriptionSize = WSA_DESCRIPTIONLEN + 1
  93.  
  94. Public Const WSA_SYS_STATUS_LEN = 128
  95. Public Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
  96.  
  97. Type WSADataType
  98.     wVersion As Integer
  99.     wHighVersion As Integer
  100.     szDescription As String * WSA_DescriptionSize
  101.     szSystemStatus As String * WSA_SysStatusSize
  102.     iMaxSockets As Integer
  103.     iMaxUdpDg As Integer
  104.     lpVendorInfo As Long
  105. End Type
  106.  
  107. Public Const INVALID_SOCKET = -1
  108. Public Const SOCKET_ERROR = -1
  109.  
  110. Public Const SOCK_STREAM = 1
  111. Public Const SOCK_DGRAM = 2
  112.  
  113. Public Const MAXGETHOSTSTRUCT = 1024
  114.  
  115. Public Const AF_INET = 2
  116. Public Const PF_INET = 2
  117.  
  118. Type LingerType
  119.     l_onoff As Integer
  120.     l_linger As Integer
  121. End Type
  122. ' Windows Sockets definitions of regular Microsoft C error constants
  123. Global Const WSAEINTR = 10004
  124. Global Const WSAEBADF = 10009
  125. Global Const WSAEACCES = 10013
  126. Global Const WSAEFAULT = 10014
  127. Global Const WSAEINVAL = 10022
  128. Global Const WSAEMFILE = 10024
  129. ' Windows Sockets definitions of regular Berkeley error constants
  130. Global Const WSAEWOULDBLOCK = 10035
  131. Global Const WSAEINPROGRESS = 10036
  132. Global Const WSAEALREADY = 10037
  133. Global Const WSAENOTSOCK = 10038
  134. Global Const WSAEDESTADDRREQ = 10039
  135. Global Const WSAEMSGSIZE = 10040
  136. Global Const WSAEPROTOTYPE = 10041
  137. Global Const WSAENOPROTOOPT = 10042
  138. Global Const WSAEPROTONOSUPPORT = 10043
  139. Global Const WSAESOCKTNOSUPPORT = 10044
  140. Global Const WSAEOPNOTSUPP = 10045
  141. Global Const WSAEPFNOSUPPORT = 10046
  142. Global Const WSAEAFNOSUPPORT = 10047
  143. Global Const WSAEADDRINUSE = 10048
  144. Global Const WSAEADDRNOTAVAIL = 10049
  145. Global Const WSAENETDOWN = 10050
  146. Global Const WSAENETUNREACH = 10051
  147. Global Const WSAENETRESET = 10052
  148. Global Const WSAECONNABORTED = 10053
  149. Global Const WSAECONNRESET = 10054
  150. Global Const WSAENOBUFS = 10055
  151. Global Const WSAEISCONN = 10056
  152. Global Const WSAENOTCONN = 10057
  153. Global Const WSAESHUTDOWN = 10058
  154. Global Const WSAETOOMANYREFS = 10059
  155. Global Const WSAETIMEDOUT = 10060
  156. Global Const WSAECONNREFUSED = 10061
  157. Global Const WSAELOOP = 10062
  158. Global Const WSAENAMETOOLONG = 10063
  159. Global Const WSAEHOSTDOWN = 10064
  160. Global Const WSAEHOSTUNREACH = 10065
  161. Global Const WSAENOTEMPTY = 10066
  162. Global Const WSAEPROCLIM = 10067
  163. Global Const WSAEUSERS = 10068
  164. Global Const WSAEDQUOT = 10069
  165. Global Const WSAESTALE = 10070
  166. Global Const WSAEREMOTE = 10071
  167. ' Extended Windows Sockets error constant definitions
  168. Global Const WSASYSNOTREADY = 10091
  169. Global Const WSAVERNOTSUPPORTED = 10092
  170. Global Const WSANOTINITIALISED = 10093
  171. Global Const WSAHOST_NOT_FOUND = 11001
  172. Global Const WSATRY_AGAIN = 11002
  173. Global Const WSANO_RECOVERY = 11003
  174. Global Const WSANO_DATA = 11004
  175. Global Const WSANO_ADDRESS = 11004
  176. '---ioctl Constants
  177.     Public Const FIONREAD = &H8004667F
  178.     Public Const FIONBIO = &H8004667E
  179.     Public Const FIOASYNC = &H8004667D
  180.  
  181. #If Win16 Then
  182. '---Windows System functions
  183.     Public Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Integer
  184.     Public Declare Sub MemCopy Lib "Kernel" Alias "hmemcpy" (Dest As Any, Src As Any, ByVal cb&)
  185.     Public Declare Function lstrlen Lib "Kernel" (ByVal lpString As Any) As Integer
  186. '---async notification constants
  187.     Public Const SOL_SOCKET = &HFFFF
  188.     Public Const SO_LINGER = &H80
  189.     Public Const FD_READ = &H1
  190.     Public Const FD_WRITE = &H2
  191.     Public Const FD_OOB = &H4
  192.     Public Const FD_ACCEPT = &H8
  193.     Public Const FD_CONNECT = &H10
  194.     Public Const FD_CLOSE = &H20
  195. '---SOCKET FUNCTIONS
  196.     Public Declare Function accept Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, addrlen As Integer) As Integer
  197.     Public Declare Function bind Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  198.     Public Declare Function closesocket Lib "Winsock.dll" (ByVal s As Integer) As Integer
  199.     Public Declare Function connect Lib "Winsock.dll" (ByVal s As Integer, addr As sockaddr, ByVal namelen As Integer) As Integer
  200.     Public Declare Function ioctlsocket Lib "Winsock.dll" (ByVal s As Integer, ByVal cmd As Long, argp As Long) As Integer
  201.     Public Declare Function getpeername Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  202.     Public Declare Function getsockname Lib "Winsock.dll" (ByVal s As Integer, sName As sockaddr, namelen As Integer) As Integer
  203.     Public Declare Function getsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, optlen As Integer) As Integer
  204.     Public Declare Function htonl Lib "Winsock.dll" (ByVal hostlong As Long) As Long
  205.     Public Declare Function htons Lib "Winsock.dll" (ByVal hostshort As Integer) As Integer
  206.     Public Declare Function inet_addr Lib "Winsock.dll" (ByVal cp As String) As Long
  207.     Public Declare Function inet_ntoa Lib "Winsock.dll" (ByVal inn As Long) As Long
  208.     Public Declare Function listen Lib "Winsock.dll" (ByVal s As Integer, ByVal backlog As Integer) As Integer
  209.     Public Declare Function ntohl Lib "Winsock.dll" (ByVal netlong As Long) As Long
  210.     Public Declare Function ntohs Lib "Winsock.dll" (ByVal netshort As Integer) As Integer
  211.     Public Declare Function recv Lib "Winsock.dll" (ByVal s As Integer, ByVal buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  212.     Public Declare Function recvfrom Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, from As sockaddr, fromlen As Integer) As Integer
  213.     Public Declare Function ws_select Lib "Winsock.dll" Alias "select" (ByVal nfds As Integer, readfds As Any, writefds As Any, exceptfds As Any, timeout As timeval) As Integer
  214.     Public Declare Function send Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  215.     Public Declare Function sendto Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer, to_addr As sockaddr, ByVal tolen As Integer) As Integer
  216.     Public Declare Function setsockopt Lib "Winsock.dll" (ByVal s As Integer, ByVal level As Integer, ByVal optname As Integer, optval As Any, ByVal optlen As Integer) As Integer
  217.     Public Declare Function ShutDown Lib "Winsock.dll" Alias "shutdown" (ByVal s As Integer, ByVal how As Integer) As Integer
  218.     Public Declare Function socket Lib "Winsock.dll" (ByVal af As Integer, ByVal s_type As Integer, ByVal protocol As Integer) As Integer
  219. '---DATABASE FUNCTIONS
  220.     Public Declare Function gethostbyaddr Lib "Winsock.dll" (addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer) As Long
  221.     Public Declare Function gethostbyname Lib "Winsock.dll" (ByVal host_name As String) As Long
  222.     Public Declare Function gethostname Lib "Winsock.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
  223.     Public Declare Function getservbyport Lib "Winsock.dll" (ByVal Port As Integer, ByVal proto As String) As Long
  224.     Public Declare Function getservbyname Lib "Winsock.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  225.     Public Declare Function getprotobynumber Lib "Winsock.dll" (ByVal proto As Integer) As Long
  226.     Public Declare Function getprotobyname Lib "Winsock.dll" (ByVal proto_name As String) As Long
  227. '---WINDOWS EXTENSIONS
  228.     Public Declare Function WSAStartup Lib "Winsock.dll" (ByVal wVR As Integer, lpWSAD As WSADataType) As Integer
  229.     Public Declare Function WSACleanup Lib "Winsock.dll" () As Integer
  230.     Public Declare Sub WSASetLastError Lib "Winsock.dll" (ByVal iError As Integer)
  231.     Public Declare Function WSAGetLastError Lib "Winsock.dll" () As Integer
  232.     Public Declare Function WSAIsBlocking Lib "Winsock.dll" () As Integer
  233.     Public Declare Function WSAUnhookBlockingHook Lib "Winsock.dll" () As Integer
  234.     Public Declare Function WSASetBlockingHook Lib "Winsock.dll" (ByVal lpBlockFunc As Long) As Long
  235.     Public Declare Function WSACancelBlockingCall Lib "Winsock.dll" () As Integer
  236.     Public Declare Function WSAAsyncGetServByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  237.     Public Declare Function WSAAsyncGetServByPort Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal Port As Integer, ByVal proto As String, buf As Any, ByVal buflen As Integer) As Integer
  238.     Public Declare Function WSAAsyncGetProtoByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal proto_name As String, buf As Any, ByVal buflen As Integer) As Integer
  239.     Public Declare Function WSAAsyncGetProtoByNumber Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal number As Integer, buf As Any, ByVal buflen As Integer) As Integer
  240.     Public Declare Function WSAAsyncGetHostByName Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal host_name As String, buf As Any, ByVal buflen As Integer) As Integer
  241.     Public Declare Function WSAAsyncGetHostByAddr Lib "Winsock.dll" (ByVal hWnd As Integer, ByVal wMsg As Integer, addr As Long, ByVal addr_len As Integer, ByVal addr_type As Integer, buf As Any, ByVal buflen As Integer) As Integer
  242.     Public Declare Function WSACancelAsyncRequest Lib "Winsock.dll" (ByVal hAsyncTaskHandle As Integer) As Integer
  243.     Public Declare Function WSAAsyncSelect Lib "Winsock.dll" (ByVal s As Integer, ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
  244.     Public Declare Function WSARecvEx Lib "Winsock.dll" (ByVal s As Integer, buf As Any, ByVal buflen As Integer, ByVal flags As Integer) As Integer
  245. #ElseIf Win32 Then
  246. '---Windows System Functions
  247.     Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  248.     Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb&)
  249.     Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
  250. '---async notification constants
  251.     Public Const SOL_SOCKET = &HFFFF&
  252.     Public Const SO_LINGER = &H80&
  253.     Public Const FD_READ = &H1&
  254.     Public Const FD_WRITE = &H2&
  255.     Public Const FD_OOB = &H4&
  256.     Public Const FD_ACCEPT = &H8&
  257.     Public Const FD_CONNECT = &H10&
  258.     Public Const FD_CLOSE = &H20&
  259. '---SOCKET FUNCTIONS
  260.     Public Declare Function accept Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, addrlen As Long) As Long
  261.     Public Declare Function bind Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  262.     Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
  263.     Public Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
  264.     Public Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
  265.     Public Declare Function getpeername Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  266.     Public Declare Function getsockname Lib "wsock32.dll" (ByVal s As Long, sName As sockaddr, namelen As Long) As Long
  267.     Public Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long
  268.     Public Declare Function htonl Lib "wsock32.dll" (ByVal hostlong As Long) As Long
  269.     Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
  270.     Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
  271.     Public Declare Function inet_ntoa Lib "wsock32.dll" (ByVal inn As Long) As Long
  272.     Public Declare Function listen Lib "wsock32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
  273.     Public Declare Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
  274.     Public Declare Function ntohs Lib "wsock32.dll" (ByVal netshort As Long) As Integer
  275.     Public Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  276.     Public Declare Function recvfrom Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, from As sockaddr, fromlen As Long) As Long
  277.     Public Declare Function ws_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readfds As fd_set, writefds As fd_set, exceptfds As fd_set, timeout As timeval) As Long
  278.     Public Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  279.     Public Declare Function sendto Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As sockaddr, ByVal tolen As Long) As Long
  280.     Public Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
  281.     Public Declare Function ShutDown Lib "wsock32.dll" Alias "shutdown" (ByVal s As Long, ByVal how As Long) As Long
  282.     Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
  283. '---DATABASE FUNCTIONS
  284.     Public Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal addr_len As Long, ByVal addr_type As Long) As Long
  285.     Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
  286.     Public Declare Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Long) As Long
  287.     Public Declare Function getservbyport Lib "wsock32.dll" (ByVal Port As Long, ByVal proto As String) As Long
  288.     Public Declare Function getservbyname Lib "wsock32.dll" (ByVal serv_name As String, ByVal proto As String) As Long
  289.     Public Declare Function getprotobynumber Lib "wsock32.dll" (ByVal proto As Long) As Long
  290.     Public Declare Function getprotobyname Lib "wsock32.dll" (ByVal proto_name As String) As Long
  291. '---WINDOWS EXTENSIONS
  292.     Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
  293.     Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
  294.     Public Declare Sub WSASetLastError Lib "wsock32.dll" (ByVal iError As Long)
  295.     Public Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
  296.     Public Declare Function WSAIsBlocking Lib "wsock32.dll" () As Long
  297.     Public Declare Function WSAUnhookBlockingHook Lib "wsock32.dll" () As Long
  298.     Public Declare Function WSASetBlockingHook Lib "wsock32.dll" (ByVal lpBlockFunc As Long) As Long
  299.     Public Declare Function WSACancelBlockingCall Lib "wsock32.dll" () As Long
  300.     Public Declare Function WSAAsyncGetServByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal serv_name As String, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  301.     Public Declare Function WSAAsyncGetServByPort Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal Port As Long, ByVal proto As String, buf As Any, ByVal buflen As Long) As Long
  302.     Public Declare Function WSAAsyncGetProtoByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal proto_name As String, buf As Any, ByVal buflen As Long) As Long
  303.     Public Declare Function WSAAsyncGetProtoByNumber Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal number As Long, buf As Any, ByVal buflen As Long) As Long
  304.     Public Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal host_name As String, buf As Any, ByVal buflen As Long) As Long
  305.     Public Declare Function WSAAsyncGetHostByAddr Lib "wsock32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, addr As Long, ByVal addr_len As Long, ByVal addr_type As Long, buf As Any, ByVal buflen As Long) As Long
  306.     Public Declare Function WSACancelAsyncRequest Lib "wsock32.dll" (ByVal hAsyncTaskHandle As Long) As Long
  307.     Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
  308.     Public Declare Function WSARecvEx Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
  309. #End If
  310.  
  311.  
  312. 'SOME STUFF I ADDED
  313. Public MySocket%
  314. Public SockReadBuffer$
  315. Public Const WSA_NoName = "Unknown"
  316. Public WSAStartedUp As Boolean     'Flag to keep track of whether winsock WSAStartup wascalled
  317.  
  318.  
  319. Public Function WSAGetAsyncBufLen(ByVal lParam As Long) As Long
  320.     If (lParam And &HFFFF&) > &H7FFF Then
  321.         WSAGetAsyncBufLen = (lParam And &HFFFF&) - &H10000
  322.     Else
  323.         WSAGetAsyncBufLen = lParam And &HFFFF&
  324.     End If
  325. End Function
  326.  
  327. Public Function WSAGetSelectEvent(ByVal lParam As Long) As Integer
  328.     If (lParam And &HFFFF&) > &H7FFF Then
  329.         WSAGetSelectEvent = (lParam And &HFFFF&) - &H10000
  330.     Else
  331.         WSAGetSelectEvent = lParam And &HFFFF&
  332.     End If
  333. End Function
  334.  
  335.  
  336.  
  337. Public Function WSAGetAsyncError(ByVal lParam As Long) As Integer
  338.     WSAGetAsyncError = (lParam And &HFFFF0000) \ &H10000
  339. End Function
  340.  
  341.  
  342.  
  343. Public Function AddrToIP(ByVal AddrOrIP$) As String
  344.     AddrToIP$ = GetAscIP(GetHostByNameAlias(AddrOrIP$))
  345. End Function
  346.  
  347. 'this function should work on 16 and 32 bit systems
  348. #If Win16 Then
  349.     Function ConnectSock(ByVal Host$, ByVal Port%, retIpPort$, ByVal HWndToMsg%, ByVal Async%) As Integer
  350.     Dim s%, SelectOps%, dummy%
  351. #ElseIf Win32 Then
  352.     Function ConnectSock(ByVal Host$, ByVal Port&, retIpPort$, ByVal HWndToMsg&, ByVal Async%) As Long
  353.     Dim s&, SelectOps&, dummy&
  354. #End If
  355.     Dim sockin As sockaddr
  356.     SockReadBuffer$ = ""
  357.     sockin = saZero
  358.     sockin.sin_family = AF_INET
  359.     sockin.sin_port = htons(Port)
  360.     If sockin.sin_port = INVALID_SOCKET Then
  361.         ConnectSock = INVALID_SOCKET
  362.         Exit Function
  363.     End If
  364.  
  365.     sockin.sin_addr = GetHostByNameAlias(Host$)
  366.     If sockin.sin_addr = INADDR_NONE Then
  367.         ConnectSock = INVALID_SOCKET
  368.         Exit Function
  369.     End If
  370.     retIpPort$ = GetAscIP$(sockin.sin_addr) & ":" & ntohs(sockin.sin_port)
  371.  
  372.     s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  373.     If s < 0 Then
  374.         ConnectSock = INVALID_SOCKET
  375.         Exit Function
  376.     End If
  377.     If SetSockLinger(s, 1, 0) = SOCKET_ERROR Then
  378.         If s > 0 Then
  379.             dummy = closesocket(s)
  380.         End If
  381.         ConnectSock = INVALID_SOCKET
  382.         Exit Function
  383.     End If
  384.     If Not Async Then
  385.         If Not connect(s, sockin, sockaddr_size) = 0 Then
  386.             If s > 0 Then
  387.                 dummy = closesocket(s)
  388.             End If
  389.             ConnectSock = INVALID_SOCKET
  390.             Exit Function
  391.         End If
  392.         If HWndToMsg <> 0 Then
  393.             SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  394.             If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  395.                 If s > 0 Then
  396.                     dummy = closesocket(s)
  397.                 End If
  398.                 ConnectSock = INVALID_SOCKET
  399.                 Exit Function
  400.             End If
  401.         End If
  402.     Else
  403.         SelectOps = FD_READ Or FD_WRITE Or FD_CONNECT Or FD_CLOSE
  404.         If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  405.             If s > 0 Then
  406.                 dummy = closesocket(s)
  407.             End If
  408.             ConnectSock = INVALID_SOCKET
  409.             Exit Function
  410.         End If
  411.         If connect(s, sockin, sockaddr_size) <> -1 Then
  412.             If s > 0 Then
  413.                 dummy = closesocket(s)
  414.             End If
  415.             ConnectSock = INVALID_SOCKET
  416.             Exit Function
  417.         End If
  418.     End If
  419.     ConnectSock = s
  420. End Function
  421.  
  422. #If Win32 Then
  423.     Public Function SetSockLinger(ByVal SockNum&, ByVal OnOff%, ByVal LingerTime%) As Long
  424. #Else
  425.     Public Function SetSockLinger(ByVal SockNum%, ByVal OnOff%, ByVal LingerTime%) As Integer
  426. #End If
  427.     Dim Linger As LingerType
  428.     Linger.l_onoff = OnOff
  429.     Linger.l_linger = LingerTime
  430.     If setsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  431.         Debug.Print "Error setting linger info: " & WSAGetLastError()
  432.         SetSockLinger = SOCKET_ERROR
  433.     Else
  434.         If getsockopt(SockNum, SOL_SOCKET, SO_LINGER, Linger, 4) Then
  435.             Debug.Print "Error getting linger info: " & WSAGetLastError()
  436.             SetSockLinger = SOCKET_ERROR
  437.         Else
  438.             Debug.Print "Linger is on if nonzero: "; Linger.l_onoff
  439.             Debug.Print "Linger time if linger is on: "; Linger.l_linger
  440.         End If
  441.     End If
  442. End Function
  443.  
  444. Sub EndWinsock()
  445.     Dim ret&
  446.     If WSAIsBlocking() Then
  447.         ret = WSACancelBlockingCall()
  448.     End If
  449.     ret = WSACleanup()
  450.     WSAStartedUp = False
  451. End Sub
  452.  
  453. Public Function GetAscIP(ByVal inn As Long) As String
  454.     #If Win32 Then
  455.         Dim nStr&
  456.     #Else
  457.         Dim nStr%
  458.     #End If
  459.     Dim lpStr&
  460.     Dim retString$
  461.     retString = String(32, 0)
  462.     lpStr = inet_ntoa(inn)
  463.     If lpStr Then
  464.         nStr = lstrlen(lpStr)
  465.         If nStr > 32 Then nStr = 32
  466.         MemCopy ByVal retString, ByVal lpStr, nStr
  467.         retString = Left(retString, nStr)
  468.         GetAscIP = retString
  469.     Else
  470.         GetAscIP = "255.255.255.255"
  471.     End If
  472. End Function
  473.  
  474. Public Function GetHostByAddress(ByVal addr As Long) As String
  475.     Dim phe&, ret&
  476.     Dim heDestHost As HostEnt
  477.     Dim HostName$
  478.     phe = gethostbyaddr(addr, 4, PF_INET)
  479.     If phe Then
  480.         MemCopy heDestHost, ByVal phe, hostent_size
  481.         HostName = String(256, 0)
  482.         MemCopy ByVal HostName, ByVal heDestHost.h_name, 256
  483.         GetHostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)
  484.     Else
  485.         GetHostByAddress = WSA_NoName
  486.     End If
  487. End Function
  488.  
  489. 'returns IP as long, in network byte order
  490. Public Function GetHostByNameAlias(ByVal HostName$) As Long
  491.     'Return IP address as a long, in network byte order
  492.     Dim phe&
  493.     Dim heDestHost As HostEnt
  494.     Dim addrList&
  495.     Dim retIP&
  496.     retIP = inet_addr(HostName$)
  497.     If retIP = INADDR_NONE Then
  498.         phe = gethostbyname(HostName$)
  499.         If phe <> 0 Then
  500.             MemCopy heDestHost, ByVal phe, hostent_size
  501.             MemCopy addrList, ByVal heDestHost.h_addr_list, 4
  502.             MemCopy retIP, ByVal addrList, heDestHost.h_length
  503.         Else
  504.             retIP = INADDR_NONE
  505.         End If
  506.     End If
  507.     GetHostByNameAlias = retIP
  508. End Function
  509.  
  510. 'returns your local machines name
  511. Public Function GetLocalHostName() As String
  512.     Dim sName$
  513.     sName = String(256, 0)
  514.     If gethostname(sName, 256) Then
  515.         sName = WSA_NoName
  516.     Else
  517.         If InStr(sName, Chr(0)) Then
  518.             sName = Left(sName, InStr(sName, Chr(0)) - 1)
  519.         End If
  520.     End If
  521.     GetLocalHostName = sName
  522. End Function
  523.  
  524. #If Win16 Then
  525.     Public Function GetPeerAddress(ByVal s%) As String
  526.     Dim addrlen%
  527. #ElseIf Win32 Then
  528.     Public Function GetPeerAddress(ByVal s&) As String
  529.     Dim addrlen&
  530. #End If
  531.     Dim sa As sockaddr
  532.     addrlen = sockaddr_size
  533.     If getpeername(s, sa, addrlen) Then
  534.         GetPeerAddress = ""
  535.     Else
  536.         GetPeerAddress = SockAddressToString(sa)
  537.     End If
  538. End Function
  539.  
  540. #If Win16 Then
  541.     Public Function GetPortFromString(ByVal PortStr$) As Integer
  542. #ElseIf Win32 Then
  543.     Public Function GetPortFromString(ByVal PortStr$) As Long
  544. #End If
  545.     'sometimes users provide ports outside the range of a VB
  546.     'integer, so this function returns an integer for a string
  547.     'just to keep an error from happening, it converts the
  548.     'number to a negative if needed
  549.     If Val(PortStr$) > 32767 Then
  550.         GetPortFromString = CInt(Val(PortStr$) - &H10000)
  551.     Else
  552.         GetPortFromString = Val(PortStr$)
  553.     End If
  554.     If Err Then GetPortFromString = 0
  555. End Function
  556.  
  557. #If Win16 Then
  558.     Function GetProtocolByName(ByVal protocol$) As Integer
  559.     Dim tmpShort%
  560. #ElseIf Win32 Then
  561.     Function GetProtocolByName(ByVal protocol$) As Long
  562.     Dim tmpShort&
  563. #End If
  564.     Dim ppe&
  565.     Dim peDestProt As protoent
  566.     ppe = getprotobyname(protocol)
  567.     If ppe Then
  568.         MemCopy peDestProt, ByVal ppe, protoent_size
  569.         GetProtocolByName = peDestProt.p_proto
  570.     Else
  571.         tmpShort = Val(protocol)
  572.         If tmpShort Then
  573.             GetProtocolByName = htons(tmpShort)
  574.         Else
  575.             GetProtocolByName = SOCKET_ERROR
  576.         End If
  577.     End If
  578. End Function
  579.  
  580. #If Win16 Then
  581.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Integer
  582.     Dim serv%
  583. #ElseIf Win32 Then
  584.     Function GetServiceByName(ByVal service$, ByVal protocol$) As Long
  585.     Dim serv&
  586. #End If
  587.     Dim pse&
  588.     Dim seDestServ As servent
  589.     pse = getservbyname(service, protocol)
  590.     If pse Then
  591.         MemCopy seDestServ, ByVal pse, servent_size
  592.         GetServiceByName = seDestServ.s_port
  593.     Else
  594.         serv = Val(service)
  595.         If serv Then
  596.             GetServiceByName = htons(serv)
  597.         Else
  598.             GetServiceByName = INVALID_SOCKET
  599.         End If
  600.     End If
  601. End Function
  602.  
  603. 'this function DOES work on 16 and 32 bit systems
  604. #If Win16 Then
  605.     Function GetSockAddress(ByVal s%) As String
  606.     Dim addrlen%
  607.     Dim ret%
  608. #ElseIf Win32 Then
  609.     Function GetSockAddress(ByVal s&) As String
  610.     Dim addrlen&
  611.     Dim ret&
  612. #End If
  613.     Dim sa As sockaddr
  614.     Dim szRet$
  615.     szRet = String(32, 0)
  616.     addrlen = sockaddr_size
  617.     If getsockname(s, sa, addrlen) Then
  618.         GetSockAddress = ""
  619.     Else
  620.         GetSockAddress = SockAddressToString(sa)
  621.     End If
  622. End Function
  623.  
  624. 'this function should work on 16 and 32 bit systems
  625. Function GetWSAErrorString(ByVal errnum&) As String
  626.     On Error Resume Next
  627.     Select Case errnum
  628.         Case 10004: GetWSAErrorString = "Interrupted system call."
  629.         Case 10009: GetWSAErrorString = "Bad file number."
  630.         Case 10013: GetWSAErrorString = "Permission Denied."
  631.         Case 10014: GetWSAErrorString = "Bad Address."
  632.         Case 10022: GetWSAErrorString = "Invalid Argument."
  633.         Case 10024: GetWSAErrorString = "Too many open files."
  634.         Case 10035: GetWSAErrorString = "Operation would block."
  635.         Case 10036: GetWSAErrorString = "Operation now in progress."
  636.         Case 10037: GetWSAErrorString = "Operation already in progress."
  637.         Case 10038: GetWSAErrorString = "Socket operation on nonsocket."
  638.         Case 10039: GetWSAErrorString = "Destination address required."
  639.         Case 10040: GetWSAErrorString = "Message too long."
  640.         Case 10041: GetWSAErrorString = "Protocol wrong type for socket."
  641.         Case 10042: GetWSAErrorString = "Protocol not available."
  642.         Case 10043: GetWSAErrorString = "Protocol not supported."
  643.         Case 10044: GetWSAErrorString = "Socket type not supported."
  644.         Case 10045: GetWSAErrorString = "Operation not supported on socket."
  645.         Case 10046: GetWSAErrorString = "Protocol family not supported."
  646.         Case 10047: GetWSAErrorString = "Address family not supported by protocol family."
  647.         Case 10048: GetWSAErrorString = "Address already in use."
  648.         Case 10049: GetWSAErrorString = "Can't assign requested address."
  649.         Case 10050: GetWSAErrorString = "Network is down."
  650.         Case 10051: GetWSAErrorString = "Network is unreachable."
  651.         Case 10052: GetWSAErrorString = "Network dropped connection."
  652.         Case 10053: GetWSAErrorString = "Software caused connection abort."
  653.         Case 10054: GetWSAErrorString = "Connection reset by peer."
  654.         Case 10055: GetWSAErrorString = "No buffer space available."
  655.         Case 10056: GetWSAErrorString = "Socket is already connected."
  656.         Case 10057: GetWSAErrorString = "Socket is not connected."
  657.         Case 10058: GetWSAErrorString = "Can't send after socket shutdown."
  658.         Case 10059: GetWSAErrorString = "Too many references: can't splice."
  659.         Case 10060: GetWSAErrorString = "Connection timed out."
  660.         Case 10061: GetWSAErrorString = "Connection refused."
  661.         Case 10062: GetWSAErrorString = "Too many levels of symbolic links."
  662.         Case 10063: GetWSAErrorString = "File name too long."
  663.         Case 10064: GetWSAErrorString = "Host is down."
  664.         Case 10065: GetWSAErrorString = "No route to host."
  665.         Case 10066: GetWSAErrorString = "Directory not empty."
  666.         Case 10067: GetWSAErrorString = "Too many processes."
  667.         Case 10068: GetWSAErrorString = "Too many users."
  668.         Case 10069: GetWSAErrorString = "Disk quota exceeded."
  669.         Case 10070: GetWSAErrorString = "Stale NFS file handle."
  670.         Case 10071: GetWSAErrorString = "Too many levels of remote in path."
  671.         Case 10091: GetWSAErrorString = "Network subsystem is unusable."
  672.         Case 10092: GetWSAErrorString = "Winsock DLL cannot support this application."
  673.         Case 10093: GetWSAErrorString = "Winsock not initialized."
  674.         Case 10101: GetWSAErrorString = "Disconnect."
  675.         Case 11001: GetWSAErrorString = "Host not found."
  676.         Case 11002: GetWSAErrorString = "Nonauthoritative host not found."
  677.         Case 11003: GetWSAErrorString = "Nonrecoverable error."
  678.         Case 11004: GetWSAErrorString = "Valid name, no data record of requested type."
  679.         Case Else:
  680.     End Select
  681. End Function
  682.  
  683. 'this function DOES work on 16 and 32 bit systems
  684. Function IpToAddr(ByVal AddrOrIP$) As String
  685.     On Error Resume Next
  686.     IpToAddr = GetHostByAddress(GetHostByNameAlias(AddrOrIP$))
  687.     If Err Then IpToAddr = WSA_NoName
  688. End Function
  689.  
  690. 'this function DOES work on 16 and 32 bit systems
  691. Function IrcGetAscIp(ByVal IPL$) As String
  692.     'this function is IRC specific, it expects a long ip stored in Network byte order, in a string
  693.     'the kind that would be parsed out of a DCC command string
  694.     On Error GoTo IrcGetAscIPError:
  695.     Dim lpStr&
  696. #If Win16 Then
  697.     Dim nStr%
  698. #ElseIf Win32 Then
  699.     Dim nStr&
  700. #End If
  701.     Dim retString$
  702.     Dim inn&
  703.     If Val(IPL) > 2147483647 Then
  704.         inn = Val(IPL) - 4294967296#
  705.     Else
  706.         inn = Val(IPL)
  707.     End If
  708.     inn = ntohl(inn)
  709.     retString = String(32, 0)
  710.     lpStr = inet_ntoa(inn)
  711.     If lpStr = 0 Then
  712.         IrcGetAscIp = "0.0.0.0"
  713.         Exit Function
  714.     End If
  715.     nStr = lstrlen(lpStr)
  716.     If nStr > 32 Then nStr = 32
  717.     MemCopy ByVal retString, ByVal lpStr, nStr
  718.     retString = Left(retString, nStr)
  719.     IrcGetAscIp = retString
  720.     Exit Function
  721. IrcGetAscIPError:
  722.     IrcGetAscIp = "0.0.0.0"
  723.     Exit Function
  724.     Resume
  725. End Function
  726.  
  727. 'this function DOES work on 16 and 32 bit systems
  728. Function IrcGetLongIp(ByVal AscIp$) As String
  729.     'this function converts an ascii ip string into a long ip in network byte order
  730.     'and stick it in a string suitable for use in a DCC command.
  731.     On Error GoTo IrcGetLongIpError:
  732.     Dim inn&
  733.     inn = inet_addr(AscIp)
  734.     inn = htonl(inn)
  735.     If inn < 0 Then
  736.         IrcGetLongIp = CVar(inn + 4294967296#)
  737.         Exit Function
  738.     Else
  739.         IrcGetLongIp = CVar(inn)
  740.         Exit Function
  741.     End If
  742.     Exit Function
  743. IrcGetLongIpError:
  744.     IrcGetLongIp = "0"
  745.     Exit Function
  746.     Resume
  747. End Function
  748.  
  749. 'this function should work on 16 and 32 bit systems
  750. #If Win16 Then
  751. Public Function ListenForConnect(ByVal Port%, ByVal HWndToMsg%) As Integer
  752.     Dim s%, dummy%
  753.     Dim SelectOps%
  754. #ElseIf Win32 Then
  755. Public Function ListenForConnect(ByVal Port&, ByVal HWndToMsg&) As Long
  756.     Dim s&, dummy&
  757.     Dim SelectOps&
  758. #End If
  759.     Dim sockin As sockaddr
  760.     sockin = saZero     'zero out the structure
  761.     sockin.sin_family = AF_INET
  762.     sockin.sin_port = htons(Port)
  763.     If sockin.sin_port = INVALID_SOCKET Then
  764.         ListenForConnect = INVALID_SOCKET
  765.         Exit Function
  766.     End If
  767.     sockin.sin_addr = htonl(INADDR_ANY)
  768.     If sockin.sin_addr = INADDR_NONE Then
  769.         ListenForConnect = INVALID_SOCKET
  770.         Exit Function
  771.     End If
  772.     s = socket(PF_INET, SOCK_STREAM, 0)
  773.     If s < 0 Then
  774.         ListenForConnect = INVALID_SOCKET
  775.         Exit Function
  776.     End If
  777.     If bind(s, sockin, sockaddr_size) Then
  778.         If s > 0 Then
  779.             dummy = closesocket(s)
  780.         End If
  781.         ListenForConnect = INVALID_SOCKET
  782.         Exit Function
  783.     End If
  784.     SelectOps = FD_READ Or FD_WRITE Or FD_CLOSE Or FD_ACCEPT
  785.     If WSAAsyncSelect(s, HWndToMsg, ByVal 1025, ByVal SelectOps) Then
  786.         If s > 0 Then
  787.             dummy = closesocket(s)
  788.         End If
  789.         ListenForConnect = SOCKET_ERROR
  790.         Exit Function
  791.     End If
  792.     
  793.     If listen(s, 1) Then
  794.         If s > 0 Then
  795.             dummy = closesocket(s)
  796.         End If
  797.         ListenForConnect = INVALID_SOCKET
  798.         Exit Function
  799.     End If
  800.     ListenForConnect = s
  801. End Function
  802.  
  803. 'this function should work on 16 and 32 bit systems
  804. #If Win16 Then
  805. Public Function SendData(ByVal s%, vMessage As Variant) As Integer
  806. #ElseIf Win32 Then
  807. Public Function SendData(ByVal s&, vMessage As Variant) As Long
  808. #End If
  809.     Dim TheMsg() As Byte, sTemp$
  810.     TheMsg = ""
  811.     Select Case VarType(vMessage)
  812.         Case 8209   'byte array
  813.             sTemp = vMessage
  814.             TheMsg = sTemp
  815.         Case 8      'string, if we recieve a string, its assumed we are linemode
  816.             #If Win32 Then
  817.                 sTemp = StrConv(vMessage, vbFromUnicode)
  818.             #Else
  819.                 sTemp = vMessage
  820.             #End If
  821.         Case Else
  822.             sTemp = CStr(vMessage)
  823.             #If Win32 Then
  824.                 sTemp = StrConv(vMessage, vbFromUnicode)
  825.             #Else
  826.                 sTemp = vMessage
  827.             #End If
  828.     End Select
  829.     TheMsg = sTemp
  830.     If UBound(TheMsg) > -1 Then
  831.         SendData = send(s, TheMsg(0), UBound(TheMsg) + 1, 0)
  832.     End If
  833. End Function
  834.  
  835. Public Function SockAddressToString(sa As sockaddr) As String
  836.     SockAddressToString = GetAscIP(sa.sin_addr) & ":" & ntohs(sa.sin_port)
  837. End Function
  838.  
  839. Public Function StartWinsock(sDescription As String) As Boolean
  840.     Dim StartupData As WSADataType
  841.     If Not WSAStartedUp Then
  842.         If Not WSAStartup(&H101, StartupData) Then
  843.             WSAStartedUp = True
  844.             Debug.Print "wVersion="; StartupData.wVersion, "wHighVersion="; StartupData.wHighVersion
  845.             Debug.Print "If wVersion == 257 then everything is kewl"
  846.             Debug.Print "szDescription="; StartupData.szDescription
  847.             Debug.Print "szSystemStatus="; StartupData.szSystemStatus
  848.             Debug.Print "iMaxSockets="; StartupData.iMaxSockets, "iMaxUdpDg="; StartupData.iMaxUdpDg
  849.             sDescription = StartupData.szDescription
  850.         Else
  851.             WSAStartedUp = False
  852.         End If
  853.     End If
  854.     StartWinsock = WSAStartedUp
  855. End Function
  856.  
  857. Public Function WSAMakeSelectReply(TheEvent%, TheError%) As Long
  858.     WSAMakeSelectReply = (TheError * &H10000) + (TheEvent And &HFFFF&)
  859. End Function
  860.  
  861.  
  862.